home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
baswiz19.zip
/
BW$BAS.ZIP
/
BCDDIV.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-29
|
2KB
|
61 lines
' +----------------------------------------------------------------------+
' | |
' | BASWIZ Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' | The BASIC Wizard's Library |
' | |
' +----------------------------------------------------------------------+
DECLARE FUNCTION BCDAbs$ (Nr AS STRING)
DECLARE FUNCTION BCDAdd$ (Nr1 AS STRING, Nr2 AS STRING)
DECLARE FUNCTION BCDCompare% (Nr1 AS STRING, Nr2 AS STRING)
DECLARE FUNCTION BCDSet$ (NumSt$)
DECLARE FUNCTION BCDSgn% (Nr AS STRING)
DECLARE FUNCTION BCDSub$ (Nr1 AS STRING, Nr2 AS STRING)
DECLARE SUB BCDDiv1L (Nr AS STRING)
DECLARE SUB BCDDiv1R (Nr AS STRING)
DEFINT A-Z
FUNCTION BCDDiv$ (Nr1 AS STRING, Nr2 AS STRING)
IF BCDSgn(Nr2) = 0 THEN
BCDDiv$ = ""
ELSEIF BCDSgn(Nr1) = 0 THEN
BCDDiv$ = Nr1
ELSE
Sign1$ = LEFT$(Nr1, 1)
Sign2$ = LEFT$(Nr2, 1)
N1$ = BCDAbs$(Nr1)
N2$ = BCDAbs$(Nr2)
Result$ = BCDSet$("0")
ShiftTrack$ = BCDSet$("1")
DO
Flip = 0
Ready = 0
DO
SELECT CASE BCDCompare(N2$, N1$)
CASE -1
BCDDiv1L N2$
BCDDiv1L ShiftTrack$
Flip = -1
CASE 0
Ready = -1
CASE 1
BCDDiv1R N2$
BCDDiv1R ShiftTrack$
Ready = Flip
END SELECT
IF BCDSgn(ShiftTrack$) = 0 THEN Ready = -1
LOOP UNTIL Ready
Result$ = BCDAdd$(Result$, ShiftTrack$)
N1$ = BCDSub$(N1$, N2$)
LOOP WHILE BCDSgn(ShiftTrack$) AND BCDSgn(N1$)
IF Sign1$ = Sign2$ THEN
BCDDiv$ = Sign1$ + MID$(Result$, 2)
ELSE
BCDDiv$ = "-" + MID$(Result$, 2)
END IF
END IF
END FUNCTION